home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Tech Arsenal 1
/
Tech Arsenal (Arsenal Computer).ISO
/
tek-02
/
der12.zip
/
DERDEMO.PAS
< prev
next >
Wrap
Pascal/Delphi Source File
|
1993-01-04
|
5KB
|
157 lines
{$B-,D-,T-,I-,L-,S-,V-}
{$M 16384,0,655360 }
Program DERDemo;
Uses
Crt, Qwik, WndwVars, Wndw, DER;
Type
Str15 = String[15];
Str20 = String[20];
Date = Word;
Test_Record = Record
TString : Str20;
TDate : Date;
TTime : Time;
TPhone : Phone;
TWord : Word;
TInteger : Integer;
TByte : Byte;
TReal : Real;
TSex : Byte;
TYesNo : Byte;
T1a : Byte;
T1b : Byte;
TSSN : SSN;
End;
Var
Test_Info : Test_Record;
ExtKey : Boolean;
JulDef : Word;
DefaultDate : Date;
{$I DERDEMO.WND}
Function DisplayQuestion(Var Test_Info: Test_Record;Which:Integer):Char;
Const
Up : CharSet = [CursorUp];
Down : CharSet = [CursorDown,Return];
Next : CharSet = [Escape,PageDown,PageUp];
Var
TC : Char;
LL : Byte;
I : Byte;
Begin
With Test_Info Do
Begin
Case Which of
1: Begin
QWrite( 5,17,NormalAtt,TimeToString(TTime));
QWrite( 7,17,NormalAtt,WordToString(TWord));
QWrite( 9,17,NormalAtt,ByteToString(TByte));
QWrite(11,17,NormalAtt,BooleanToString(TSex,'M','F'));
QWrite(13,33,NormalAtt,SSNToString(TSSN));
QWrite( 3,58,NormalAtt,DateToStr(TDate));
QWrite( 5,58,NormalAtt,PhoneToString(TPhone));
QWrite( 7,58,NormalAtt,IntegerToString(TInteger));
QWrite( 9,58,NormalAtt,RealToString(TReal));
QWrite(11,58,NormalAtt,BooleanToString(TYesNo,'Y','N'));
LL := 1;
Repeat
Case LL Of
1: TC := SelectString(TString,20,17,3);
2: TC := SelectTime(TTime,17,5);
3: TC := SelectWord(TWord,0,65000,5,17,7);
4: TC := SelectByte(TByte,0,255,3,17,9);
5: TC := SelectBoolean(TSex,'M','F',17,11);
6: TC := SelectSSN(TSSN,33,13);
7: TC := SelectDate(TDate,58,3);
8: TC := SelectPhone(TPhone,58,5);
9: TC := SelectInteger(TInteger,0,32000,5,58,7);
10: TC := SelectReal(TReal,0,99.99,5,58,9);
11: TC := SelectBoolean(TYesNo,'Y','N',58,11);
12: NormalAtt := ColorSelect(15,24, 2,16);
13: ReverseAtt := ColorSelect(15,60, 5,15);
End;
CheckLimit(LL,TC,Up,Down,1,13);
Until TC in Next;
End; { of Case = 1 }
2: Begin
For I := 1 to 8 Do ShowMultipleChoice(T1a,I,1,3);
For I := 1 to 6 Do ShowMultipleChoice(T1b,I,9,3);
LL := 1;
Repeat
Case LL Of
1 : TC := SelectMultiple(T1a,1,8,3,1);
2 : TC := SelectMultiple(T1b,1,6,3,9);
End;
CheckLimit(LL,TC,Up,Down,1,2);
Until TC in Next;
End;
End; { of case }
End; { of With }
DisplayQuestion := TC;
End;
Procedure AskQuestions(Var Test_Info : Test_Record);
Const
Limit : Byte = 2;
Up : CharSet = [PageUp];
Down : CharSet = [PageDown];
Var
TC : Char;
I,J: Byte;
Begin
I := 1;
With Test_Info do
Begin
TC := #0;
Repeat
MakeWindow(1,1,25,80,NormalAtt,NormalAtt,SingleBrdr,aWindow);
TitleWindow(Top,Left,' F1 = Help ');
TitleWindow(Top,Right,' ESC = QUIT ');
TitleWindow(Bottom,Left,' Data Entry Routines Version 1.2 ');
TitleWindow(Bottom,Right,' by: Juan M. Vegarra ');
Case I of
1 : Begin
For J := 3 To 15 Do QWrite(J,2,NormalAtt,Wind01[J]);
TC := DisplayQuestion(Test_Info, 1);
End;
2 : Begin
For J := 2 To 15 Do QWrite(J,2,NormalAtt,TISS[J]);
TC := DisplayQuestion(Test_Info, 2);
End;
End;
RemoveWindow;
CheckLimit(I,TC,Up,Down,1,Limit);
Until TC = Escape;
End;
End;
Procedure InitialRoutine;
Begin
CheckBreak := False;
CheckSnow := QSnow;
CheckCursor;
InitWindow(NormalAtt,True);
CursorOff;
Today(DefaultDate);
ExtKey := False;
FillChar(Test_Info, SizeOf(Test_Record), 0);
Test_Info.TDate := DefaultDate;
End;
Begin
InitialRoutine;
AskQuestions(Test_Info);
CursorOn;
NormVideo;
ClrScr;
End.